home *** CD-ROM | disk | FTP | other *** search
/ START Magazine / START VOL 3 NO 5.st / GENINPUT.ARC / LISTING1.LST next >
Encoding:
File List  |  1988-09-20  |  31.1 KB  |  1,010 lines
  1. ' =============================================================================
  2. '         LISTING 1          GENERALIZED INPUT ROUTINES            03/25/1988
  3. '                                 BY MICHAEL HEPNER
  4. '                         COPYRIGHT 1988 ANTIC PUBLISHING INC.
  5. ' =============================================================================
  6. '
  7. Fullw 1
  8. Titlew 1," Generalized Input Routines "
  9. Cls
  10. '
  11. ' -----------------------------------------------------------------------------
  12. '       CHECK SCREEN RESOLUTION:  Must run in MEDIUM or HIGH resolution.
  13. ' -----------------------------------------------------------------------------
  14. Rez%=Xbios(4)
  15. If Rez%=0 Then
  16.   Alert 3," Please switch to | | MEDIUM RESOLUTION ",1," OK ",B
  17.   Quit
  18. Endif
  19. '
  20. ' -----------------------------------------------------------------------------
  21. '     INITIALIZE: Call the Generalized Initialization Routines
  22. ' -----------------------------------------------------------------------------
  23. Gosub Menu_setup
  24. Gosub Fld_dimen
  25. '
  26. ' -----------------------------------------------------------------------------
  27. '                      SHOW LIST OF OPTIONS AVAILABLE:
  28. '              When selected option is done, show the list again.
  29. ' -----------------------------------------------------------------------------
  30. Do
  31.   Gosub Show_main_option_list
  32. Loop
  33. '
  34. ' ----------------------------  END OF MAIN PROGRAM  --------------------------
  35. '
  36. '
  37. ' =============================================================================
  38. ' SHOW_MAIN_OPTION_LIST:  This procedure shows how to initialize the DATA
  39. '        values and call the Generalized Option List Procedure.
  40. ' -----------------------------------------------------------------------------
  41. Procedure Show_main_option_list
  42.   Titlew 1," Generalized Input Routines "
  43.   '
  44.   Restore Main_list_menu_data                   ! Build the customized
  45.   Gosub Build_menu_bar                          ! drop down menus.
  46.   '
  47.   Repeat
  48.     Restore Main_option_list_data               ! Build the customized
  49.     Gosub Show_option_list                      ! option list.
  50.     '
  51.     Gosub Check_which_option                    ! Wait for MOUSE or Func-key.
  52.   Until Function%>0
  53.   '
  54.   On Function% Gosub Option1,Option2,Option3    !  ... OptionN
  55. Return
  56. '
  57. '
  58. ' =============================================================================
  59. ' ==========              OPTION 1  -  __________________            ==========
  60. ' =============================================================================
  61. Procedure Option1
  62.   Titlew 1," Option One "
  63.   Cls
  64.   '
  65.   Restore Opt1_menu_data                        ! Different
  66.   Gosub Build_menu_bar                          ! drop down menus.
  67.   '
  68.   Restore Opt1_fld_data                         ! Set up the
  69.   Gosub Fld_setup                               ! data entry screen.
  70.   '
  71.   Opt_done%=0
  72.   While Opt_done%=0
  73.     Gosub Process_option1
  74.   Wend
  75. Return
  76. '
  77. ' =============================================================================
  78. ' PROCESS_OPTION1:  ______________
  79. ' -----------------------------------------------------------------------------
  80. Procedure Process_option1
  81.   For I%=1 To Num_flds%
  82.     Fld_val$(I%)=Space$(Fld_leng%(I%))
  83.   Next I%
  84.   Redraw%=1
  85.   '
  86.   Rec_done%=0
  87.   Repeat
  88.     If Redraw%=1 Then                           ! First time or after desk
  89.       Gosub Show_headings                       ! accessory, display screen.
  90.     Endif
  91.     '
  92.     Gosub Ask_for_opt1_field
  93.     Fld_num%=Nxt_fld%
  94.   Until Rec_done%>0
  95. Return
  96. '
  97. ' =============================================================================
  98. ' ASK_FOR_OPT1_FIELD:  Print the field prompt, and input the field.
  99. '                _________________________________________________
  100. '               |   One common procedure is best when there are   |
  101. '               |   no further edits needed on the input fields.  |
  102. '                -------------------------------------------------
  103. ' -----------------------------------------------------------------------------
  104. Procedure Ask_for_opt1_field
  105.   Temp$=Fld_val$(Fld_num%)
  106.   Gosub Check_field_input
  107.   Fld_val$(Fld_num%)=Temp$
  108.   '
  109.   Gosub Clear_box
  110. Return
  111. '
  112. '
  113. ' =============================================================================
  114. ' ==========         OPTION 2  -  ________________                   ==========
  115. ' =============================================================================
  116. Procedure Option2
  117.   Titlew 1," Option Two "
  118.   Cls
  119.   '
  120.   Restore Opt2_menu_data                        ! Different
  121.   Gosub Build_menu_bar                          ! drop down menus.
  122.   '
  123.   Restore Opt2_fld_data                         ! Different
  124.   Gosub Fld_setup                               ! field definitions.
  125.   '
  126.   Opt_done%=0
  127.   Repeat
  128.     Gosub Process_option2
  129.   Until Opt_done%>0
  130. Return
  131. '
  132. ' =============================================================================
  133. ' PROCESS_OPTION2:  ______________
  134. ' -----------------------------------------------------------------------------
  135. Procedure Process_option2
  136.   For I%=1 To Num_flds%
  137.     Fld_val$(I%)=Space$(Fld_leng%(I%))
  138.   Next I%
  139.   Redraw%=1
  140.   '
  141.   Rec_done%=0
  142.   Repeat
  143.     If Redraw%=1 Then                           ! First time or after desk
  144.       Gosub Show_headings                       ! accessory, display screen.
  145.     Endif
  146.     '
  147.     On Fld_num% Gosub Ask_field1,Ask_field2,Ask_field3
  148.     Fld_num%=Nxt_fld%
  149.     '
  150.     ' ------------ Edit all the fields when Rec_done%=1
  151.   Until Rec_done%>0
  152. Return
  153. '
  154. ' =============================================================================
  155. ' ASK_FIELD1:  Ask for the first field.
  156. ' -----------------------------------------------------------------------------
  157. Procedure Ask_field1
  158.   Temp$=Fld_val$(Fld_num%)
  159.   Gosub Check_field_input
  160.   Fld_val$(Fld_num%)=Temp$
  161.   '
  162.   Gosub Clear_box
  163.   '
  164.   '                    Additional edits can go here.
  165. Return
  166. '
  167. ' =============================================================================
  168. ' ASK_FIELD2:  Ask for the second field.
  169. ' -----------------------------------------------------------------------------
  170. Procedure Ask_field2
  171.   Temp$=Fld_val$(Fld_num%)
  172.   Gosub Check_field_input
  173.   Fld_val$(Fld_num%)=Temp$
  174.   '
  175.   Gosub Clear_box
  176.   '
  177.   '                    Additional edits can go here.
  178. Return
  179. '
  180. ' =============================================================================
  181. ' ASK_FIELD3:  Ask for the third field.
  182. ' -----------------------------------------------------------------------------
  183. Procedure Ask_field3
  184.   Temp$=Fld_val$(Fld_num%)
  185.   Gosub Check_field_input
  186.   Fld_val$(Fld_num%)=Temp$
  187.   '
  188.   Gosub Clear_box
  189.   '
  190.   '                    Additional edits can go here.
  191. Return
  192. '
  193. '
  194. ' =============================================================================
  195. ' ==========                   OPTION 3  -  EXIT                     ==========
  196. ' =============================================================================
  197. Procedure Option3
  198.   Alert 2,"    Do you really    | |    want to QUIT?    ",1,"YES|NO ",B
  199.   If B=1 Then
  200.     @Restorepal
  201.     Edit
  202.   Endif
  203. Return
  204. '
  205. '
  206. ' =============================================================================
  207. '               GENERALIZED INPUT ROUTINES TO PROCESS THE MENU BAR
  208. ' =============================================================================
  209. '
  210. ' -----------------------------------------------------------------------------
  211. ' MENU_SETUP:  Dimension the Menu Bar Array, initialize variables,
  212. '              and set the screen colors and text size.
  213. ' -----------------------------------------------------------------------------
  214. Procedure Menu_setup
  215.   Max_menu%=150                           ! Make this as big as you need.
  216.   Dim Menu_bar$(Max_menu%)
  217.   Dim Spalette%(16,3)
  218.   '
  219.   Insert_mode%=0
  220.   First_redraw%=0
  221.   Redraw%=0
  222.   '
  223.   @Save_pal
  224.   If Rez%=1 Then
  225.     Setcolor 0,7,7,7
  226.     Setcolor 1,7,0,0
  227.     Setcolor 2,0,0,4
  228.     Setcolor 3,0,0,0
  229.     Txt_size%=6
  230.   Else
  231.     Setcolor 0,7,7,7
  232.     Setcolor 1,0,0,0
  233.     Txt_size%=13
  234.   Endif
  235. Return
  236. '
  237. '
  238. ' ==============================================================================
  239. ' BUILD_MENU_BAR:  Builds the drop down menus and activates them.
  240. ' -----------------------------------------------------------------------------
  241. Procedure Build_menu_bar
  242.   For I%=0 To Max_menu%
  243.     Read Menu_bar$(I%)
  244.     Exit If Menu_bar$(I%)="***"
  245.   Next I%
  246.   '
  247.   Menu_bar$(I%)=""
  248.   Menu Menu_bar$()
  249.   On Menu  Gosub Menu_handler
  250.   On Menu Message Gosub Menu_message
  251. Return
  252. '
  253. ' -----------------------------------------------------------------------------
  254. ' DATA for MENU BAR:  First line is needed to activate the desk accessories.
  255. '        On other lines, the first value will appear on the menu bar and the
  256. '        following values will appear on the drop down menu.
  257. ' -----------------------------------------------------------------------------
  258. Main_list_menu_data:
  259. Data DESK, About Gen. Input ,------------------,1,2,3,4,5,6,""
  260. Data QUIT, End Program,""
  261. Data ***
  262. '
  263. Opt1_menu_data:
  264. Data DESK, About Gen. Input ,------------------,1,2,3,4,5,6,""
  265. Data QUIT, End Program,""
  266. Data DONE, Return to Menu,""
  267. Data OTHER, Put Optional, Features in the, Drop Down Menu,""
  268. Data ***
  269. '
  270. Opt2_menu_data:
  271. Data DESK, About Gen. Input ,------------------,1,2,3,4,5,6,""
  272. Data QUIT, End Program,""
  273. Data DONE, Return to Menu,""
  274. Data OTHER, More Optional, Features, Can Go Here,""
  275. Data ***
  276. '
  277. '
  278. ' =============================================================================
  279. ' MENU_HANDLER:  Determines which drop down menu option was selected.
  280. ' -----------------------------------------------------------------------------
  281. Procedure Menu_handler
  282.   Menu Off
  283.   Menu_option$=Menu_bar$(Menu(0))
  284.   '
  285.   If Menu_option$=" Return to Menu" Then
  286.     Fld_done%=99
  287.     Rec_done%=99
  288.     Opt_done%=99
  289.   Endif
  290.   '
  291.   If Menu_option$=" End Program" Then
  292.     Gosub Option3
  293.   Endif
  294.   '
  295.   If Menu_option$=" About Gen. Input " Then
  296.     A$="Generalized Input Routines|"
  297.     A1$="    Sample--Listing 1|"
  298.     A2$="    by Michael Hepner|"
  299.     A3$=" "+Chr$(189)+" 1988 Antic Publishing"
  300.     Alert 1,A$+A1$+A2$+A3$,1,"OK",A
  301.   Endif
  302.   '
  303.   '                ____________________________________________
  304.   '               |  Code an IF statement for each selection   |
  305.   '               |  defined on the drop down menus.           |
  306.   '                --------------------------------------------
  307. Return
  308. '
  309. '
  310. ' =============================================================================
  311. ' MENU_MESSAGE:  Determine if the screen needs to be redrawn.
  312. '        (Ignore first call which comes at the start of the program.)
  313. ' -----------------------------------------------------------------------------
  314. Procedure Menu_message
  315.   If Menu(1)=20 Then
  316.     If First_redraw%=0 Then
  317.       First_redraw%=1
  318.     Else
  319.       Redraw%=1
  320.     Endif
  321.     '
  322.     If Rez%=1 Then
  323.       Setcolor 0,7,7,7
  324.       Setcolor 1,7,0,0
  325.       Setcolor 2,0,0,4
  326.       Setcolor 3,0,0,0
  327.     Else
  328.       Setcolor 0,7,7,7
  329.       Setcolor 1,0,0,0
  330.     Endif
  331.   Endif
  332. Return
  333. '
  334. '
  335. ' =============================================================================
  336. '              GENERALIZED ROUTINES TO PROCESS THE OPTION LIST
  337. ' =============================================================================
  338. '
  339. ' -----------------------------------------------------------------------------
  340. ' SHOW_OPTION_LIST:  Using DATA statements, build the list of options.
  341. '        Before calling this procedure, use a RESTORE command to point to
  342. '        the DATA statements for the option list.
  343. ' -----------------------------------------------------------------------------
  344. Procedure Show_option_list
  345.   Cls
  346.   Color 2
  347.   Defline 1,1,0,0
  348.   '
  349.   Read Offset%,Spacing%
  350.   Offset%=Offset%*Rez%
  351.   Spacing%=Spacing%*Rez%
  352.   '
  353.   Read Num_select%
  354.   For I%=1 To Num_select%
  355.     Read Select$
  356.     Y%=Spacing%*(I%-1)+Offset%
  357.     Deftext 2,0,0,Txt_size%
  358.     Text 192,Y%-Rez%,"F"
  359.     Text 200,Y%-Rez%,I%
  360.     Rbox 180,Y%-9*Rez%,221,Y%+Rez%
  361.     Deftext 1,0,0,Txt_size%
  362.     Text 248,Y%-Rez%,Select$
  363.   Next I%
  364.   '
  365.   Gosub Build_box
  366.   Text 160,152*Rez%,"Press function key of desired option,"
  367.   Text 304,160*Rez%,"or"
  368.   Text 160,168*Rez%,"click the MOUSE on the desired option."
  369. Return
  370. '
  371. ' -----------------------------------------------------------------------------
  372. ' DATA for OPTION LIST:  Options are listed using the TEXT command.
  373. '        First data value gives the Y coordinate for the first option.
  374. '        Second value gives the text spacing between options.
  375. '        Third value is the number of options followed by their text values.
  376. '        For even spacing, use one of the following sets:
  377. '            56, 28,  2      (Minimum number of options)
  378. '            48, 22,  3
  379. '            34, 24,  4
  380. '            28, 22,  5
  381. '            22, 20,  6
  382. '            18, 18,  7
  383. '            16, 16,  8
  384. '            16, 14,  9
  385. '            14, 13, 10      (Maximum number of options)
  386. '        You may also adjust the spacing if you wish to print extra lines
  387. '        on the Option List Screen.
  388. ' -----------------------------------------------------------------------------
  389. Main_option_list_data:
  390. Data 48,22
  391. Data 3
  392. Data Option One
  393. Data Option Two
  394. Data Quit
  395. '
  396. '
  397. ' =============================================================================
  398. ' CHECK_WHICH_OPTION:  Processes user inputs from the Option Screen.
  399. ' -----------------------------------------------------------------------------
  400. Procedure Check_which_option
  401.   On Menu Key Gosub Check_function_key
  402.   On Menu Button 1,1,1 Gosub Compute_mouse_option
  403.   '
  404.   Function%=0
  405.   Redraw%=0
  406.   Repeat
  407.     On Menu
  408.   Until (Function%>0 And Function%<=Num_select%) Or Redraw%=1
  409. Return
  410. '
  411. '
  412. ' =============================================================================
  413. ' CHECK_FUNCTION_KEY:  Only responds if function key matches an option.
  414. ' -----------------------------------------------------------------------------
  415. Procedure Check_function_key
  416.   If (Menu(14) And 255)=0 Then
  417.     Key%=Menu(14)/256
  418.     If Key%>58 And Key%<=58+Num_select% Then
  419.       Function%=Key%-58
  420.     Endif
  421.   Endif
  422. Return
  423. '
  424. '
  425. ' =============================================================================
  426. ' COMPUTE_MOUSE_OPTION:  Only responds if MOUSE was clicked on an option.
  427. ' -----------------------------------------------------------------------------
  428. Procedure Compute_mouse_option
  429.   Y%=Menu(11)-22*Rez%
  430.   Y1%=Y%-Offset%+9*Rez%
  431.   Y2%=Int(Y1%/Spacing%)
  432.   Y3%=Y1%-Y2%*Spacing%
  433.   If Y3%>=0 And Y3%<=10*Rez% Then
  434.     Function%=Y2%+1
  435.   Endif
  436. Return
  437. '
  438. '
  439. ' =============================================================================
  440. '     GENERALIZED ROUTINES FOR DEFINING THE INPUT FIELDS AND SCREEN LAYOUT
  441. ' =============================================================================
  442. '
  443. ' -----------------------------------------------------------------------------
  444. ' FLD_DIMEN:  Dimension the Field Arrays (large enough for the largest set).
  445. ' -----------------------------------------------------------------------------
  446. Procedure Fld_dimen
  447.   Max_flds%=3                            ! Make this as large as you need.
  448.   Dim Fld_hstart%(Max_flds%),Fld_yline%(Max_flds%),Fld_xstart%(Max_flds%)
  449.   Dim Fld_leng%(Max_flds%),Fld_type$(Max_flds%),Fld_heading$(Max_flds%)
  450.   Dim Fld_prompt$(Max_flds%),Fld_help$(Max_flds%)
  451.   Dim Fld_val$(Max_flds%)
  452. Return
  453. '
  454. '
  455. ' =============================================================================
  456. ' FLD_SETUP:  For each different screen, read the DATA statements that define
  457. '        each field on the screen, and build the screen definition arrays.
  458. ' -----------------------------------------------------------------------------
  459. Procedure Fld_setup
  460.   Read Num_flds%
  461.   For I%=1 To Num_flds%
  462.     Read Fld_hstart%(I%),Fld_yline%(I%),Fld_xstart%(I%)
  463.     Read Fld_leng%(I%),Fld_type$(I%),Fld_heading$(I%)
  464.     Read Fld_prompt$(I%),Fld_help$(I%)
  465.   Next I%
  466. Return
  467. '
  468. ' -----------------------------------------------------------------------------
  469. ' DATA for SCREEN SETUP:  First data value tells how many sets of data follow.
  470. '        Each set contains four numeric values and four text values:
  471. '           X coordinate of header, Y coordinate, X coordinate of field,
  472. '           length, type, heading, prompt, and help message.
  473. ' -----------------------------------------------------------------------------
  474. Opt1_fld_data:
  475. Data 2
  476. '
  477. Data 120,40,184,25,A-Z,Field1
  478. Data "Enter value for Field #1."
  479. Data "Field #1 must be alphabetic.  Space, comma, or dash is also allowed."
  480. '
  481. Data 160,60,224,20,ANY,Field2
  482. Data "Enter value for Field #2."
  483. Data "Field #2 may contain any characters."
  484. '
  485. Opt2_fld_data:
  486. Data 3
  487. '
  488. Data 184,30,248,5,NUM,Number
  489. Data "Enter a number."
  490. Data "Only numeric characters are valid."
  491. '
  492. Data 184,50,256,12,DEC,Decimal
  493. Data "Enter a decimal value."
  494. Data "Only numbers and a decimal point are allowed."
  495. '
  496. Data 240,90,328,1,Y/N,Yes-or-No
  497. Data "Answer question (Y/N)."
  498. Data "Enter Y for Yes   or   N for No."
  499. '
  500. '                ___________________________________________
  501. '               |   You can define a field as any "type".   |
  502. '               |   You code how each "type" is edited in   |
  503. '               |   the HAVE_DATA Procedure.                |
  504. '                -------------------------------------------
  505. '
  506. '
  507. ' =============================================================================
  508. ' SHOW_HEADINGS:  Using the screen definition arrays, build the screen and
  509. '        build the instruction box at the bottom of the screen.
  510. ' -----------------------------------------------------------------------------
  511. Procedure Show_headings
  512.   Cls
  513.   Defline 1,1,0,0
  514.   Color 2
  515.   For I%=1 To Num_flds%
  516.     Y%=Fld_yline%(I%)*Rez%
  517.     Text Fld_hstart%(I%),Y%,Fld_heading$(I%)
  518.     Text Fld_hstart%(I%)+8*Len(Fld_heading$(I%)),Y%,":"
  519.     X%=Fld_xstart%(I%)
  520.     Text X%,Y%,Fld_val$(I%)
  521.     Line X%,Y%+2,X%-1+8*Fld_leng%(I%),Y%+2
  522.   Next I%
  523.   '
  524.   Gosub Build_box
  525.   Box 4,125*Rez%,634,139*Rez%
  526.   Box 9,127*Rez%,629,137*Rez%
  527.   Deffill 2,1
  528.   Fill 7,126*Rez%
  529.   '
  530.   Deftext 3,0,0,Txt_size%
  531.   Text 24,135*Rez%,"Press F10 when all fields are correct."
  532.   '
  533.   If Insert_mode%=0 Then
  534.     Deftext 2,0,0,Txt_size%
  535.     Text 488,135*Rez%,"Insert mode: Off"
  536.   Else
  537.     Deftext 3,0,0,Txt_size%
  538.     Text 488,135*Rez%,"Insert mode: ON "
  539.   Endif
  540.   Deftext 1,0,0,Txt_size%
  541.   '
  542.   Fld_num%=1
  543.   Xsub%=1
  544. Return
  545. '
  546. '
  547. ' =============================================================================
  548. ' BUILD_BOX:  Draws a box with thick border.
  549. ' -----------------------------------------------------------------------------
  550. Procedure Build_box
  551.   Color 2
  552.   Defline 1,1,0,0
  553.   Box 4,137*Rez%,634,176*Rez%
  554.   Box 9,139*Rez%,629,174*Rez%
  555.   Deffill 2,1
  556.   Fill 7,138*Rez%
  557. Return
  558. '
  559. '
  560. ' =============================================================================
  561. ' CLEAR_BOX:  Erases the inside of the box.
  562. ' -----------------------------------------------------------------------------
  563. Procedure Clear_box
  564.   Deffill 0,1
  565.   Pbox 24,144*Rez%,604,168*Rez%
  566. Return
  567. '
  568. '
  569. ' =============================================================================
  570. '                        ROUTINES TO READ AN ENTIRE FIELD
  571. ' =============================================================================
  572. '
  573. ' -----------------------------------------------------------------------------
  574. ' CHECK_FIELD_INPUT:  Processes user inputs from a data entry screen.
  575. ' -----------------------------------------------------------------------------
  576. Procedure Check_field_input
  577.   Hold$=Temp$
  578.   '
  579.   X%=Int((80-Len(Fld_prompt$(Fld_num%)))/2)
  580.   Print At(X%,20);Fld_prompt$(Fld_num%)
  581.   '
  582.   Xstart%=Fld_xstart%(Fld_num%)
  583.   Yline%=Fld_yline%(Fld_num%)*Rez%
  584.   Fleng%=Fld_leng%(Fld_num%)
  585.   Type_input$=Fld_type$(Fld_num%)
  586.   '
  587.   Gosub Cursor
  588.   '
  589.   On Menu Key Gosub Check_field_key
  590.   On Menu Button 1,1,1 Gosub Compute_mouse_field
  591.   '
  592.   Fld_done%=0
  593.   Redraw%=0
  594.   Repeat
  595.     On Menu
  596.   Until Fld_done%>0 Or Redraw%=1
  597. Return
  598. '
  599. '
  600. ' =============================================================================
  601. ' CHECK_FIELD_KEY:  Processes keyboard inputs from a data entry screen.
  602. ' -----------------------------------------------------------------------------
  603. Procedure Check_field_key
  604.   Menu Off
  605.   If Menu(13)>=4 Then                    ! Skip Control & Alternate characters
  606.     Gosub Beep
  607.   Else
  608.     If (Menu(14) And 255)=0 Then
  609.       Gosub Check_special_key
  610.     Else
  611.       Gosub Check_regular_key
  612.     Endif
  613.   Endif
  614. Return
  615. '
  616. '
  617. ' =============================================================================
  618. ' CHECK_REGULAR_KEY:  Processes standard keys.
  619. ' -----------------------------------------------------------------------------
  620. Procedure Check_regular_key
  621.   If Menu(14)=7181 Then                  ! Return
  622.     Gosub Finish_field
  623.   Else
  624.     If Menu(14)=3849                     ! Tab
  625.       Gosub Finish_field
  626.     Else
  627.       If Menu(14)=29197 Then             ! Enter
  628.         Gosub Finish_field
  629.       Else
  630.         If Menu(14)=3592 Then            ! Backspace
  631.           Gosub Have_backspace
  632.         Else
  633.           If Menu(14)=21375 Then         ! Delete
  634.             Gosub Have_delete
  635.           Else
  636.             If Menu(14)=283 Then         ! Escape
  637.               Gosub Clear_field
  638.             Else
  639.               Gosub Have_data            ! add character to field
  640.             Endif
  641.           Endif
  642.         Endif
  643.       Endif
  644.     Endif
  645.   Endif
  646. Return
  647. '
  648. '
  649. ' =============================================================================
  650. ' CHECK_SPECIAL_KEY:  Processes function keys and other special keys.
  651. '     (Only function key F10 is used by the sample data entry screen.)
  652. '             ( Fkey=59 for F1   ---->   Fkey=67 for F9 )
  653. ' -----------------------------------------------------------------------------
  654. Procedure Check_special_key
  655.   Fkey=Menu(14)/256
  656.   If Fkey=72 Then                        ! Up Arrow
  657.     Nxt_fld%=Fld_num%-1
  658.     Nxt_xsub%=1
  659.     Gosub Next_field
  660.   Else
  661.     If Fkey=80 Then                      ! Down Arrow
  662.       Nxt_fld%=Fld_num%+1
  663.       Nxt_xsub%=1
  664.       Gosub Next_field
  665.     Else
  666.       If Fkey=75 Then                    ! Left Arrow
  667.         Gosub Have_left_arrow
  668.       Else
  669.         If Fkey=77 Then                  ! Right Arrow
  670.           Gosub Have_right_arrow
  671.         Else
  672.           If Fkey=82 Then                ! Insert
  673.             Gosub Have_insert
  674.           Else
  675.             If Fkey=71 Then              ! Clr Home
  676.               Gosub Clear_field
  677.             Else
  678.               If Fkey=97 Then            ! Undo
  679.                 Gosub Have_undo_key
  680.               Else
  681.                 If Fkey=98 Then          ! Help
  682.                   Gosub Have_help_key
  683.                 Else
  684.                   If Fkey=68 Then        ! F10
  685.                     Gosub Record_is_done
  686.                   Endif
  687.                 Endif
  688.               Endif
  689.             Endif
  690.           Endif
  691.         Endif
  692.       Endif
  693.     Endif
  694.   Endif
  695. Return
  696. '
  697. '
  698. ' =============================================================================
  699. ' COMPUTE_MOUSE_FIELD:  Computes which field the MOUSE was clicked on.
  700. ' -----------------------------------------------------------------------------
  701. Procedure Compute_mouse_field
  702.   X%=Menu(10)
  703.   Y%=Menu(11)-22*Rez%
  704.   '
  705.   Fld%=0
  706.   For I%=1 To Num_flds%
  707.     If X%>=Fld_hstart%(I%) And X%<Fld_xstart%(I%)+8*Fld_leng%(I%) Then
  708.       If Y%>=Fld_yline%(I%)-7*Rez% And Y%<Fld_yline%(I%)*Rez% Then
  709.         Fld%=I%
  710.       Endif
  711.     Endif
  712.     Exit If Fld%>0
  713.   Next I%
  714.   '
  715.   If X%<=Fld_xstart%(Fld%) Then
  716.     Nxt_xsub%=1
  717.   Else
  718.     Nxt_xsub%=Int((X%-Fld_xstart%(Fld%))/8)+1
  719.   Endif
  720.   '
  721.   If Fld%>0 Then
  722.     If Fld%=Fld_num% Then
  723.       Gosub Cursor
  724.       Xsub%=Nxt_xsub%
  725.       Gosub Cursor
  726.     Else
  727.       Nxt_fld%=Fld%
  728.       Gosub Next_field
  729.     Endif
  730.   Endif
  731. Return
  732. '
  733. '
  734. ' =============================================================================
  735. ' CURSOR:  Draws or erases the cursor block.
  736. ' -----------------------------------------------------------------------------
  737. Procedure Cursor
  738.   Graphmode 3
  739.   Deffill 1,1
  740.   Xchar%=Xstart%+(Xsub%-1)*8
  741.   Pbox Xchar%-1,Yline%+2*Rez%,Xchar%+8,Yline%-8*Rez%
  742.   Graphmode 1
  743. Return
  744. '
  745. '
  746. ' =============================================================================
  747. ' HAVE_DATA:  Check if key is valid for this field type.
  748. ' -----------------------------------------------------------------------------
  749. Procedure Have_data
  750.   C$=Chr$(Menu(14))
  751.   If Type_input$="ANY" Then
  752.     Gosub Keep_data
  753.   Else
  754.     If Type_input$="A-Z" Then
  755.       If Instr(" .,-ABCDEFGHIJKLMNOPQRSTUVWXYZ",Upper$(C$)) Then
  756.         Gosub Keep_data
  757.       Else
  758.         Gosub Beep
  759.       Endif
  760.     Else
  761.       If Type_input$="Y/N" Then
  762.         C$=Upper$(C$)
  763.         If Instr("YN",C$) Then
  764.           Gosub Keep_data
  765.         Else
  766.           Gosub Beep
  767.         Endif
  768.       Else
  769.         If Type_input$="NUM" Then
  770.           If Instr("0123456789",C$) Then
  771.             Gosub Keep_data
  772.           Else
  773.             Gosub Beep
  774.           Endif
  775.         Else
  776.           If Type_input$="DEC" Then
  777.             If Instr("-.0123456789",C$) Then
  778.               Gosub Keep_data
  779.             Else
  780.               Gosub Beep
  781.             Endif
  782.           Endif
  783.         Endif
  784.       Endif
  785.     Endif
  786.   Endif
  787. Return
  788. '
  789. '
  790. ' =============================================================================
  791. ' KEEP_DATA:  Key is valid, so add it to the field.
  792. ' -----------------------------------------------------------------------------
  793. Procedure Keep_data
  794.   Gosub Cursor
  795.   '
  796.   If Insert_mode%=1 Then
  797.     L%=Fleng%-Xsub%
  798.     If L%>0 Then
  799.       Mid$(Temp$,Xsub%+1,L%)=Mid$(Temp$,Xsub%,L%)
  800.       Mid$(Temp$,Xsub%,1)=" "
  801.       Text Xstart%,Yline%,Temp$
  802.     Endif
  803.   Endif
  804.   '
  805.   Text Xchar%,Yline%,C$
  806.   Mid$(Temp$,Xsub%,1)=C$
  807.   If Xsub%<Fleng% Then
  808.     Inc Xsub%
  809.     Add Xchar%,8
  810.   Endif
  811.   Gosub Cursor
  812. Return
  813. '
  814. '
  815. ' =============================================================================
  816. ' BEEP:  Key is not valid, so make a beeping noise.
  817. ' -----------------------------------------------------------------------------
  818. Procedure Beep
  819.   Sound 1,12,1,8,1
  820.   Sound 1,0,0,0
  821. Return
  822. '
  823. '
  824. ' =============================================================================
  825. ' FINISH_FIELD:  Set flag for field done, determine which field is next.
  826. ' -----------------------------------------------------------------------------
  827. Procedure Finish_field
  828.   Gosub Cursor
  829.   '
  830.   Fld_done%=1
  831.   Nxt_fld%=Fld_num%+1
  832.   If Nxt_fld%>Num_flds% Then
  833.     Nxt_fld%=1
  834.   Endif
  835.   Xsub%=1
  836. Return
  837. '
  838. '
  839. ' =============================================================================
  840. ' NEXT_FIELD:  Field may not be done, determine which field is next.
  841. ' -----------------------------------------------------------------------------
  842. Procedure Next_field
  843.   Gosub Cursor
  844.   '
  845.   Fld_done%=99
  846.   If Nxt_fld%<1 Then
  847.     Nxt_fld%=Num_flds%
  848.   Else
  849.     If Nxt_fld%>Num_flds% Then
  850.       Nxt_fld%=1
  851.     Endif
  852.   Endif
  853.   Xsub%=Nxt_xsub%
  854. Return
  855. '
  856. '
  857. ' =============================================================================
  858. ' HAVE_LEFT_ARROW:  Move cursor left but leave data as is.
  859. ' -----------------------------------------------------------------------------
  860. Procedure Have_left_arrow
  861.   If Xsub%>1 Then
  862.     Gosub Cursor
  863.     Dec Xsub%
  864.     Gosub Cursor
  865.   Endif
  866. Return
  867. '
  868. '
  869. ' =============================================================================
  870. ' HAVE_RIGHT_ARROW:  Move cursor right but leave data as is.
  871. ' -----------------------------------------------------------------------------
  872. Procedure Have_right_arrow
  873.   If Xsub%<Fleng% Then
  874.     Gosub Cursor
  875.     Inc Xsub%
  876.     Gosub Cursor
  877.   Endif
  878. Return
  879. '
  880. '
  881. ' =============================================================================
  882. ' HAVE_BACKSPACE:  Move cursor left, pulling data with it.
  883. '      You can make the BACKSPACE key act like the LEFT ARROW key by
  884. '      deleting this procedure and changing the related GOSUB statement
  885. '      to GOSUB HAVE_LEFT_ARROW.
  886. ' -----------------------------------------------------------------------------
  887. Procedure Have_backspace
  888.   If Xsub%>1 Then
  889.     Gosub Cursor
  890.     Dec Xsub%
  891.     Gosub Cursor
  892.     Gosub Have_delete
  893.   Endif
  894. Return
  895. '
  896. '
  897. ' =============================================================================
  898. ' HAVE_DELETE:  Pull data from the right into this position.
  899. ' -----------------------------------------------------------------------------
  900. Procedure Have_delete
  901.   Gosub Cursor
  902.   L%=Fleng%-Xsub%
  903.   If L%=0 Then
  904.     Mid$(Temp$,Fleng%,1)=" "
  905.     Text Xchar%,Yline%," "
  906.   Else
  907.     Mid$(Temp$,Xsub%,L%)=Mid$(Temp$,Xsub%+1,L%)
  908.     Mid$(Temp$,Fleng%,1)=" "
  909.     Text Xstart%,Yline%,Temp$
  910.   Endif
  911.   Gosub Cursor
  912. Return
  913. '
  914. '
  915. ' =============================================================================
  916. ' HAVE_INSERT:  Toggle INSERT mode off and on.
  917. ' -----------------------------------------------------------------------------
  918. Procedure Have_insert
  919.   If Insert_mode%=0 Then
  920.     Insert_mode%=1
  921.     Deftext 3,0,0,Txt_size%
  922.     Text 488,135*Rez%,"Insert mode: ON "
  923.   Else
  924.     Insert_mode%=0
  925.     Deftext 2,0,0,Txt_size%
  926.     Text 488,135*Rez%,"Insert mode: Off"
  927.   Endif
  928.   Deftext 1,0,0,Txt_size%
  929. Return
  930. '
  931. '
  932. ' =============================================================================
  933. ' CLEAR_FIELD:  Set the current field to spaces.
  934. '    Both the CLR HOME key and the ESCAPE key call this procedure.
  935. '    You can define a separate procedure for the ESCAPE key if you
  936. '    want it to perform some other function.
  937. ' -----------------------------------------------------------------------------
  938. Procedure Clear_field
  939.   Gosub Cursor
  940.   Temp$=Space$(Fleng%)
  941.   Xsub%=1
  942.   Text Xstart%,Yline%,Temp$
  943.   Gosub Cursor
  944. Return
  945. '
  946. '
  947. ' =============================================================================
  948. ' HAVE_UNDO_KEY:  Restore the original value of the current field.
  949. ' -----------------------------------------------------------------------------
  950. Procedure Have_undo_key
  951.   Gosub Cursor
  952.   Temp$=Hold$
  953.   Xsub%=1
  954.   Text Xstart%,Yline%,Temp$
  955.   Gosub Cursor
  956. Return
  957. '
  958. '
  959. ' =============================================================================
  960. ' HAVE_HELP_KEY:  Display the HELP message.
  961. ' -----------------------------------------------------------------------------
  962. Procedure Have_help_key
  963.   X%=Int((80-Len(Fld_help$(Fld_num%)))/2)
  964.   Print At(X%,21);Fld_help$(Fld_num%)
  965. Return
  966. '
  967. '
  968. ' =============================================================================
  969. ' RECORD_IS_DONE:  Set flags to end the input process.
  970. ' -----------------------------------------------------------------------------
  971. Procedure Record_is_done
  972.   Gosub Cursor
  973.   Fld_done%=1
  974.   Rec_done%=1
  975. Return
  976. '
  977. ' ------------- SAVE ORIGINAL COLOR PALETTE -----------------------
  978. Procedure Save_pal
  979.   '
  980.   ' Requires Dim Spalette%(16,3)
  981.   '
  982.   For Z%=0 To 15
  983.     Dpoke Contrl,26
  984.     Dpoke Contrl+2,0
  985.     Dpoke Contrl+6,2
  986.     Dpoke Intin,Z%
  987.     Dpoke Intin+2,0
  988.     Vdisys
  989.     Spalette%(Z%,0)=Dpeek(Intout+2)
  990.     Spalette%(Z%,1)=Dpeek(Intout+4)
  991.     Spalette%(Z%,2)=Dpeek(Intout+6)
  992.   Next Z%
  993. Return
  994. '
  995. Procedure Restorepal
  996.   ' --------------------- RESTORES PALLET -------------------
  997.   ' Dimensions: Spalette%(16,3)
  998.   '
  999.   For Z%=0 To 15
  1000.     Dpoke Contrl,14
  1001.     Dpoke Contrl+2,0
  1002.     Dpoke Contrl+6,4
  1003.     Dpoke Intin,Z%
  1004.     Dpoke Intin+2,Spalette%(Z%,0)
  1005.     Dpoke Intin+4,Spalette%(Z%,1)
  1006.     Dpoke Intin+6,Spalette%(Z%,2)
  1007.     Vdisys
  1008.   Next Z%
  1009. Return
  1010.